COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "REVLIB"
C00003 00003	RECORD_CLASS TREE(
C00004 00004	INTEGER PROCEDURE DecayFormula(
C00005 00005	∂ Declarations for FETCH routines.
C00010 00006	∂ How to fetch units from REV file:
C00012 00007	BOOL PROC fetch_unit(
C00016 00008	PNT(TREE) PROC grow(
C00018 00009	RECURSIVE PROCEDURE acorn(
C00020 00010	PROC fetch_REV(
C00023 00011	RECURSIVE PROCEDURE normute(
C00026 00012	∂ Doing the reverberation.
C00031 00013	END "REVLIB".
C00032 ENDMK
C⊗;
BEGIN "REVLIB"
REQUIRE "HEADER[LIB,KS]" SOURCE_FILE;

∂ In what follows, all tree traversals are prefix walks, i.e. the order is:
	(process this node,
	traverse the OUTPUT subtree of this node,
	traverse all the ABURO subtrees of this node).

Each node in the tree contains a description of a single unit reverberator
sufficient for calling the all-pass reverberator simulator routine APR.  The
best version of that routine is to be found on my area [REV,KS] named APRL.FAI,
where the L means lattice form.  The source includes a sample SAIL declaration.

The abbreviation λ means NULL_RECORD.
;

RECORD_CLASS TREE(
	PNT(TREE) OUTPUT; ∂ pointer to first output node;
	PNT(TREE) ABURO; ∂ pointer to younger sibs of this node;
	∂ ... fields for the parameters to APR for this unit...;
	REAL MEM; INTEGER delay;
	REAL gain;
	INTEGER pos);

EXTERNAL PROCEDURE APR(
	REFERENCE REAL IN, OUT; INTEGER n;
	REFERENCE REAL MEM; INTEGER delay;
	REAL gain;
	REFERENCE INTEGER pos);

INTEGER PROCEDURE DecayFormula(
	REAL gain;
	INTEGER delay);
∂ Returns the number of samples of decay time corresponding to the given gain
and delay.  The decay time is the time for an impulse to drop 60 dB.
;
   RETURN(-3.0*delay/LOG10(ABS gain));
∂ Declarations for FETCH routines.;
∂ All of the following routines live in FETCH.SAI[REV,KS] as of 16 Jun 77.;

EXTERNAL PROCEDURE command_read(
	REFERENCE STRING the_command, the_arguments;
	REFERENCE BOOLEAN the_file_flag;
	INTEGER the_in_channel;
	REFERENCE INTEGER the_in_eof, the_in_break;
	STRING immediate_chars("←→↔"));
∂ Get command lines from either the TTY or the given channel.
Immediate chars do not require carriage return if typed before previous
characters are backspaced over, i.e., they have to be the first thing
typed except for initial backspaces.  This is an artifact of how this
feature is implemented.
;

EXTERNAL BOOLEAN PROCEDURE real_fetch(
	REFERENCE STRING arg;
	REFERENCE REAL value, factor);
∂ Look for a SAIL style real constant.  If * or / is given instead, value
is returned multiplied by either the fetched or default factor.  If the
default factor passed to this routine is zero, this feature is omitted.
;

EXTERNAL BOOLEAN PROCEDURE #samp_fetch(
	REFERENCE STRING arg;
	REFERENCE INTEGER value, offset);
∂ Look for an integer presumed to represent number of samples for a
reverberator.  If + or - is seen first, then value is offset that many
prime numbers to a resulting prime.
;
∂ How to fetch units from REV file:

Units will be described by two lines like this:
#SAMPLES 9999 GAIN
GAIN .999 DELAY
The fetch_unit routine should simply return these two values in the corresponding
reference parameters delay(i.e. #samples delay) and gain.

These two lines will be immediately followed (no intervening blank lines) by
some number of lines describing where to put this unit in the tree constructed
so far.  There are two possibilities:
APPEND
or
{←}*
BRANCH
The second case means there will be 0 or more lines containing the single
command "←", followed by a line with the BRANCH command.  In this case, pos
should be the number of "←" commands seen.  In the APPEND case, pos should
be returned as -1.

If a blank line is seen, then there are no further units in the tree, so the
boolean value of the routine should be FALSE.  In this case, pos should be
returned with the value INFINITY.  If a unit is found (the usual case), then
the value of the routine should be TRUE to indicate success.
;
BOOL PROC fetch_unit(
	INT channel;
	REF INT pos, delay;
	REF REAL gain);
∂ Returns TRUE iff it could fetch another unit, and FALSE with pos=INFINITY
otherwise. Pos = -1 => Append, 0 => Branch, >0 => pop(Pos times)&Branch.
It can tell when there are no more units by encountering a blank line.
;
    BEGIN "fetch unit"
    STR command, args;
    INT eof, brk;
    REAL factor;
    INT offset;

    command_read(command, args, TRUE, channel, eof, brk);
    IF EQU(command,NULL)
      THEN BEGIN
	pos ← INFINITY;
	RETURN(FALSE);
	END;

    IF NOT EQU(command,"#SAMPLES")
      THEN BEGIN
	PRINT(↓,"Bad format in REV file!  #SAMPLES expected.",
		↓,command," ",args,
		↓);
	delay ← 3;	∂ Fill in something random.;
	pos ← INFINITY;
	RETURN(FALSE);
	END
      ELSE #samp_fetch(args, delay, offset);

    command_read(command, args, TRUE, channel, eof, brk);
    IF NOT EQU(command,"GAIN")
      THEN BEGIN
	PRINT(↓,"Bad format in REV file!  GAIN expected.",
		↓,command," ",args,
		↓);
	gain ← .7;	∂ Fill in something random.;
	pos ← INFINITY;
	RETURN(FALSE);
	END
      ELSE real_fetch(args, gain, factor);

    command_read(command, args, TRUE, channel, eof, brk);
    IF EQU(command,"APPEND")
      THEN BEGIN
	pos ← -1;
	END
    ELSE IF EQU(command,"BRANCH")
      THEN BEGIN
	pos ← 0;
	END
    ELSE IF NOT EQU(command,"←")
      THEN BEGIN
	PRINT(↓,"Bad format in REV file!  APPEND, BRANCH, or ← expected.",
		↓,command," ",args,
		↓);
	pos ← INFINITY;
	RETURN(FALSE);
	END
    ELSE BEGIN
	WHILE EQU(command,"←")
	  DO BEGIN
	    pos ← 1;
	    command_read(command, args, TRUE, channel, eof, brk);
	    END;
	IF NOT EQU(command,"BRANCH")
	  THEN BEGIN
	    PRINT(↓,"Bad format in REV file!  BRANCH expected.",
		    ↓,command," ",args,
		    ↓);
	    pos ← INFINITY;
	    RETURN(FALSE);
	    END;
	END;

    RETURN(TRUE);
    END "fetch unit";
PNT(TREE) PROC grow(
	INT delay;
	REAL gain);
∂ Constructs a node of form:
	TREE[OUTPUT: NULL_RECORD
	     ABURO: NULL_RECORD
		the following are parameters to the APR routine ...
	     MEM[1:delay]: array for delay memory,
	     DELAY: length of delay memory, ← delay
	     POS: pointer into MEM maintained by APR, ← 0
	     GAIN: attenuation factor for this unit], ←  gain]
;
    BEGIN "grow"
    PNT(TREE) node;

    node ← NEW_RECORD(TREE);
    TREE:OUTPUT[node] ← λ;
    TREE:ABURO[node] ← λ;
    NewArray(INTEGER,TREE:MEM[node],[1:delay]);
    TREE:DELAY[node] ← delay;
    TREE:POS[node] ← 0;
    TREE:GAIN[node] ← gain;

    RETURN(node);
    END "grow";
RECURSIVE PROCEDURE acorn(
	INTEGER channel;
	RECORD_POINTER(TREE) node;
	REFERENCE INTEGER poly, pos, delay;
	REFERENCE REAL gain);
∂ How to create TREE of states:

Call acorn as follows:
	ignore commands from REV file thru first blank line.
	next line is Clock rate -- input sound file must use same rate.
	next line may be ignored.
	next line is the first line to be read by fetch_unit.
	call acorn(channel,rev←NEW_RECORD(TREE),poly←1,itmp1,itmp2,rtmp)
	then throw away first node in tree.
;
    BEGIN "acorn"
    WHILE fetch_unit(channel,delay,pos,gain)
     DO BEGIN
	IF pos < 0
	  THEN BEGIN
	    TREE:OUTPUT[node] ← grow(delay,gain);
	    acorn(channel,TREE:OUTPUT[node],poly,pos,delay,gain);
	    END;
	IF pos > 0
	  THEN BEGIN
	    pos ← pos-1;
	    RETURN;
	    END;
	TREE:ABURO[node] ← grow(delay,gain);
	node ← TREE:ABURO[node];
	poly ← poly+1;
	END;
    pos ← INFINITY;
    END    "acorn";
PROC fetch_REV(
	INT channel;
	REF PNT(TREE) root;
	REF INT poly;
	REF INT clock);
∂ Convert the reverberator description in the REV file on the given channel
into a TREE.  Set poly to the number of branches (output channels) in the
tree.  Set clock to the clock rate used by the reverberator.
;
    BEGIN "fetch REV"
    STR command, args;
    INT eof, brk;
    REAL clk, factor;
    INT itmp1, itmp2;
    REAL rtmp;

∂ Do the following:
	ignore commands from REV file thru first blank line.
	next line is Clock rate -- input sound file must use same rate.
	next line may be ignored.
	next line is the first line to be read by fetch_unit.
	call acorn(channel,rev←NEW_RECORD(TREE),poly←1,itmp1,itmp2,rtmp)
	then throw away first node in tree.
;

    DO command_read(command, args, TRUE, channel, eof, brk)
      UNTIL EQU(command,NULL);

    command_read(command, args, TRUE, channel, eof, brk);
    IF NOT EQU(command,"CLOCK_RATE")
      THEN BEGIN
	PRINT(↓,"Bad format in REV file!  CLOCK_RATE expected.",
		↓,command," ",args,
		↓);
	clock ← 25600;
	root ← λ;
	RETURN;
	END
      ELSE BEGIN
	real_fetch(args, clk, factor);
	clock ← clk;
	END;

    command_read(command, args, TRUE, channel, eof, brk);
    acorn(channel,root←NEW_RECORD(TREE),poly←1,itmp1,itmp2,rtmp);
    root ← TREE:OUTPUT[root];

    END "fetch REV";
RECURSIVE PROCEDURE normute(
	RECORD_POINTER(TREE) node;
	REAL gain;
	REFERENCE INTEGER MaxDecay;
	REFERENCE REAL ARRAY Norms;
	REFERENCE INTEGER ARRAY Permute;
	REFERENCE INTEGER this, next, out#);
∂   Calculate Norms and Permute.  The REF parameters this, next, and out# are
for internal use only, and have no real meaning outside this procedure.  The
gain parameter is the initial gain for normalization, and should be set to 1.0
as a rule.  The norm for a channel is defined as the factor by which the output
should be multiplied to normalize the result of reverberating a unit impulse.  It
is the inverse of the product of all the gains of all the reverberators on the
signal path from the root to the output for that particular channel.  The Permute
array is somewhat more abstract in definition.  It is a permutation of the channel
numbers so that buffers can be filled in a natural order by the reverberation
traversal without randomly scrambling the order of the output channels in the
buffers.  Simulating the reverberating traversal with a few simple trees should
be the best way to demonstrate the function of Permute.
;
∂ Call this routine with:
	normute(root_of_tree,1.0,MaxDecay←0,Norms,Permute,itmp1,itmp2,itmp3)
;
    BEGIN "normute"
    REAL lgain;
    DO BEGIN
	lgain ← gain * TREE:GAIN[node];
	MaxDecay ← MaxDecay MAX DecayFormula(TREE:GAIN[node],TREE:DELAY[node]);
	IF TREE:ABURO[node] ≠ λ
	  THEN BEGIN
	    this ← next;
	    next ← next+1;
	    END;
	IF TREE:OUTPUT[node] = λ
	  THEN BEGIN
	    Permute[this] ← out#;
	    Norms[out#] ← 1.0/lgain;
	    out# ← out#+1;
	    DO
		this ← this-1
	      UNTIL Permute[this] = 0;
	    END
	  ELSE
	    normute(TREE:OUTPUT[node],lgain,Norms,Permute,this,next,out#);
	node ← TREE:ABURO[node];
	END
      UNTIL node = λ;
    END    "normute";
∂ Doing the reverberation.;

INT poly;	∂ Number of branches (outputs) for reverberator;
DEFINE BUFSIZE = 2*1024;
PNT(TREE) root_of_tree;
INT clock_rate;
∂ Following declaration just for stub;
    INT eof;

∂ Set up REV file on channel;

∂ Create TREE, counting  poly ← # of branches.;
fetch_REV(channel,root_of_tree,poly,clock_rate);

    BEGIN "Allocate arrays"
    REAL ARRAY Bufs[1:poly,1:BUFSIZE];	∂ Allocate array of output buffers;
    REAL ARRAY Norms[1:poly];	∂ Allocate parallel array of normalizing factors;
    PNT(TREE) ARRAY Backup[0:poly];
				∂ Allocate parallel array for tree traverse "stack";
    INT ARRAY Permute[0:poly];	∂ Allocate parallel array of indices;
    INTEGER MaxDecay;	∂ How many samples of zero to feed thru at end of file;

    INT tmp1, tmp2, tmp3;

    ∂ Calculate Norms and Permute. (Explained in normute.);
    normute(root_of_tree,1.0,MaxDecay←0,Norms,Permute,tmp1,tmp2,tmp3);

    ∂ Init input file, output file;


    WHILE TRUE
      DO BEGIN "digesting a buffer"
	INT this_one, next_one, gets,
		i, j;
	PNT(TREE) node;
	this_one ← 1; next_one ← 2; ARRCLR(Backup,λ); node ← root_of_tree;

	∂ Read input into Bufs[Permute[this_one],*];

      IF eof THEN DONE "digesting a buffer"; ∂ Oops! Have to tack on Decay.;

	∂ reverberate this buffer into poly channel buffers;
	WHILE node ≠ λ
	  DO BEGIN "going thru TREE"
	    IF TREE:ABURO[node] = λ
	      THEN gets ← this_one
	      ELSE BEGIN
		gets ← next_one; next_one ← next_one+1;
		Backup[this_one] ← TREE:ABURO[node];
		END;
	    APR(Bufs[Permute[this_one],1],Bufs[Permute[gets],1],BUFSIZE,
		    TREE:MEM[node],TREE:delay[node],TREE:gain[node],TREE:pos[node]);
	    this_one ← gets;
	    Backup[this_one] ← TREE:OUTPUT[node];
	    WHILE Backup[this_one] = λ  AND  this_one > 0
	      DO this_one ← this_one-1;
	    node ← Backup[this_one];
	    END "going thru TREE";

    ∂   Multiply each buffer by the appropriate normalizing factor:
	    ∀(1 ≤ i ≤ poly,1 ≤ j ≤ BUFSIZE) Bufs[i,j] ← Bufs[i,j]*Norms[i];
	FOR i ← 1
	  THRU poly
	  DO BEGIN
	    REAL this_norm;
	    this_norm ← Norms[i];
	    FOR j ← 1
	      THRU BUFSIZE
	      DO Bufs[i,j] ← Bufs[i,j]*this_norm;
	    END;

	∂ now multiplex buffers into output. This is clever.;
	∂ treat Bufs as 1-dimensional array, indexed from 0;
	i ← 0;
	WHILE TRUE	∂ get the next output sample;
	  DO BEGIN "multiplexing"
	    next_output_sample ← MEMORY[LOCATION(Bufs[1,1])+i]; ∂ Bufs[i];
	    i ← i+BUFSIZE;
	  IF i = (poly+1)*BUFSIZE THEN DONE "multiplexing";
	    IF i ≥ poly*BUFSIZE
	      THEN i ← i+1-poly*BUFSIZE;
	    END "multiplexing"

	∂ Write output;

	END "digesting a buffer";

    END "Allocate arrays";
END "REVLIB".